;;;Solving the instant insanity puzzle by depth first search.  
;;;Solution is (SEARCH P0) and SEARCH is found in SEARCH.LSP
;;;Needs PUZZ to get set up.  PUZZ is constructed in INSANI.LSP


(DEFPROP INSANB  (BOOL-COLOR BOOL-CYCLE LOSE TER MAPCHOOSE SUCCESSORS) INSANBFNS)
(DEFPROP INSANB  (P00 PUZZA) CONSTANTS)
(DEFPROP INSANB  (MKPUZZA) MKPUZZFNS)

(DEFPROP BOOL-COLOR
 (LAMBDA (X) (COND ((EQ X (QUOTE R)) 1) ((EQ X (QUOTE W)) 2) ((EQ X (QUOTE G)) 4) (T 10)))
EXPR)

(DEFPROP BOOL-CYCLE
 (LAMBDA (V) (COND ((NULL V) 0) (T (PLUS (BOOL-COLOR (CAR V)) (TIMES 20 (BOOL-CYCLE (CDR V)))))))
EXPR)

(DEFPROP LOSE
 (LAMBDA (P) NIL)
EXPR)


(DEFPROP TER
 (LAMBDA (P) (EQUAL (LENGTH P) 5))
EXPR)

;;;MACLISP referential transparency hack
(SSTATUS PUNT NIL)

(DEFPROP MAPCHOOSE
 (LAMBDA(PRED FN U)
  (COND	((NULL U) NIL)
	((PRED (CAR U))
	 (CONS (FN (CAR U)) (MAPCHOOSE PRED FN (CDR U))))
	(T (MAPCHOOSE PRED FN (CDR U)))))
EXPR)

(DEFPROP SUCCESSORS
 (LAMBDA(P)
  (MAPCHOOSE (FUNCTION (LAMBDA (X) (ZEROP (BOOLE 1 (CAR P) X))))
	     (FUNCTION (LAMBDA (X) (CONS (BOOLE 7 (CAR P) X) P)))
	     (NTH PUZZA (LENGTH P))))
EXPR)


(DEFUN PUZZA () 
  (MAPCAR (FUNCTION (LAMBDA (X) (MAPCAR (FUNCTION BOOL-CYCLE) X))) PUZZ))

(DEFPROP PUZZA
       ((11210 22204 12204)
	(22204 41110 102044 44102 102044 44102 22204 41110 40504 42024 42101 12104 
         40504 42024 42101 12104 20604 41030 102041 14102 100444 44022 22201 11110)
	(100442	24022 21201 11050 20602 21030 101041 14042 10444 40422 22021 11101
	 20424 41021 12041 10502 100444 44022 22201 11110 20604 41030 102041 14102)
	(24024 41201 12050 100502 14044 40602 22030 101101 101104 44044 42202 22110
         41204 42050 102102 24104 21024 41041 12042 20502 11044 40442 22022 21101))
PUZZA)

(SETQ PUZZA (MKPUZZA))
(SETQ P00 '(0))

;;;(SEARCH P00)
;;;(177777 153753 53311 11210 0) 
;;;(ALLSOL P00)  3SECS
;;;((177777 153673 113251 11210 0) 
;;; (177777 153753 53311 11210 0) 
;;; (177777 153753 53311 11210 0))